home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 003 / dbtools.lbr / TOOLSLIB.DQC / TOOLSLIB.DOC
Text File  |  1986-08-05  |  15KB  |  576 lines
  1. *
  2. *********************************************** TOOLSLIB.DOC
  3. *                        08.20.84
  4. *
  5. *       THE SOFTWARE TOOLS STRING LIBRARY
  6. *       =================================
  7. *    Software Tools for dBASEII requires ver. 2.4 
  8. *    for full implementation
  9. *    The Tools defined below are a loose adaptation of
  10. *    the tools developed by Kernighan and Plauger in
  11. *    "Software Tools" and "Software Tools in Pascal"
  12. *    (one of these should be in any beginning programmers
  13. *    library) and the common and almost identical library
  14. *    functions found in most implementations of C.
  15. *    We acknowledge the above authors and Dennis Ritchie,
  16. *    co-author of "The C Programming Language" whose
  17. *    original work created these tools.
  18. *
  19. ********************************************************
  20. *                        TOOLHEAD.CMD
  21. *                        08.01.84
  22. *    SOFTWARE TOOLS STRING FUNCTION LIBRARY
  23. *    TOOLINIT initialises the primitive Software tools
  24. *    file and prepares memory for a call to TOOLCASE
  25. *    TOOLHEAD includes a get FUNCTION and stubbed get string
  26. *
  27. *    TOOLINIT does not contain this get but simply initialises
  28. *    the variables for invocation as macros
  29. *    TOOLCASE contains additional compound functions
  30. *    that cannot be nested.
  31. *
  32. *    NOTES ON USAGE
  33. *    ==============
  34. *    TOOLINIT is dumb and requires calling program to pass all parameters
  35. *    Don't say    if WRKSTR = &ISNULL
  36. *    Just say     if &ISNULL
  37. *    note that added Parens to isnull, isupper, islower to avoid problem
  38. *    with statements like ".not. &ISNULL" which contains an .and.
  39. *    and would cause and parsing problem otherwise
  40. *    See Replace header for comments on trim and accept
  41. *
  42. ********************************************************
  43. *
  44. *
  45. *
  46. erase
  47. store "        " to FUNCTION
  48. *** WRKSTR is equivalent of Kern. and Plauger newline
  49. *** PUTSTRING is equiv to PUTLINE ( output the line)
  50. store "                                 " to WRKSTR, PUTSTRING
  51.  
  52. set talk off
  53.  
  54. *** create the position of character
  55. store 1 to POS
  56. *** in calling program
  57.  
  58. *** create the current character
  59. store "$( WRKSTR, POS, 1)" to c
  60.  
  61. *** move the characterposition of character
  62. store "store 1 to POS" to FIRSTC
  63. store "store POS +1 to POS" to NEXTC
  64. store "store len( WRKSTR) to POS" to LASTC
  65.  
  66. *** look for EOS
  67. store "POS > len(trim( WRKSTR))" to EOS
  68.  
  69. *** look for empty string
  70. store "(len(trim( WRKSTR)) =1 .and. WRKSTR = ' ')" to ISNULL
  71.  
  72. *** look for different characters
  73. store "&c = ' '" to ISSPACE
  74. store "&c $ '0123456789'"  to ISDIGIT    
  75. store "(&c >= 'A' .and. &c <= 'Z')" to ISUPPER
  76. store "(&c >= 'a' .and. &c <= 'z')" to ISLOWER
  77. store "&c $ '.?!'"       to  ISENDSENT
  78.  
  79. *** case conversion
  80. store "chr(rank( &c) +32)"     to TOLOWER
  81. store "!( &c)"               to TOUPPER
  82. store "store !($( WRKSTR,1,1) + $( WRKSTR,2) to WRKSTR" to CAPFIRST
  83.  
  84. *** build a newstring
  85. store "store &c to PUTSTRING"    to PUTNWSTR
  86. store "store PUTSTRING + &c to PUTSTRING" to CHARCAT
  87.  
  88.  
  89.  
  90.  
  91.  
  92.  
  93.  
  94.  
  95.  
  96.  
  97. ?
  98. ?
  99. *** @ 22,05 say "Enter string to operate on ->" GET WRKSTR
  100. @ 23,05 say "What Function to call      ->" GET FUNCTION PICTURE "!!!!!!!!"
  101. READ
  102.  
  103.  
  104. *>>> Delete these later
  105. if FUNCTION = "WORD" .OR. FUNCTION = "WRAP" 
  106. store "XXXX is an EXTREMELY long string for testing the capacity of wrap;
  107. to perform its menial little but somewhat important task.  In short its ;
  108. a test!  Testing, testing?" to WRKSTR
  109. else
  110.     store "This is a test of a TEST TTTTT   isIS  " to WRKSTR
  111. endif
  112. *<<<
  113. if &ISNULL
  114.    @ 22,05 say "Enter string operand       ->" GET WRKSTR
  115.    read
  116. endif 
  117. *
  118. *** end of TOOLHEAD ***************************************
  119. *
  120. *
  121.  
  122. *
  123. *
  124. *********************************************** TOOLINIT.CMD
  125. *********************************************** 08/01/84  * 
  126. *
  127. *    Software Tools functions named to follow C function
  128. *    conventions.  Not all functions are necessary but
  129. *    program development can be increased with use of 
  130. *    the standard functions
  131. *
  132. *
  133. *
  134. *
  135. ********************************************************
  136. *
  137. *** TOOLINIT **
  138. *
  139. erase
  140. store "        " to FUNCTION
  141. store "                                 " to WRKSTR, PUTSTRING
  142.  
  143. set talk off
  144.  
  145. *** create theposition of character
  146. store 1 to POS
  147. *** in calling program
  148.  
  149. *** create the current character
  150. store "$( WRKSTR, POS, 1)" to c
  151.  
  152. *** move the characterposition of character
  153. store "store 1 to POS" to FIRSTC
  154. store "store POS +1 to POS" to NEXTC
  155. store "store len( WRKSTR) to POS" to LASTC
  156.  
  157. *** test for End of string - EOS
  158. store "POS > len(trim( WRKSTR))" to EOS
  159.  
  160. *** test for empty string
  161. store "(len(trim( WRKSTR)) =1 .and. WRKSTR = ' ')" to ISNULL
  162.  
  163. *** test for type of character
  164. store "&c = ' '" to ISSPACE
  165. store "&c $ '0123456789'"  to ISDIGIT    
  166. store "(&c >= 'A' .and. &c <= 'Z')" to ISUPPER
  167. store "(&c >= 'a' .and. &c <= 'z')" to ISLOWER
  168. store "&c $ '.?!'"       to  ISENDSENT
  169.  
  170. *** case conversion
  171. store "chr(rank( &c) +32)"     to TOLOWER
  172. store "!( &c)"               to TOUPPER
  173. store "store !($( WRKSTR,1,1) + $( WRKSTR,2) to WRKSTR" to CAPFIRST
  174.  
  175. *** build a newstring
  176. store "store &c to PUTSTRING"    to PUTNWSTR
  177. store "store PUTSTRING + &c to PUTSTRING" to CHARCAT
  178. ?
  179. ?
  180. *** @ 22,05 say "Enter string to operate on ->" GET WRKSTR
  181. *** @ 23,05 say "What Function to call      ->" GET FUNCTION PICTURE "!!!!!!!!"
  182. *** READ
  183.  
  184.  
  185. *>>> Delete these later
  186. if FUNCTION = "WORD" .OR. FUNCTION = "WRAP" .OR. FUNCTION = "JUSTIFY"
  187. store ;
  188. "XXXX is an EXTREMELY long string for testing the capacity of text processing;
  189. code to perform its menial little but somewhat important task.    In short its ;
  190. a test!  Testing, testing?  Is this going to be it?" to WRKSTR
  191. else
  192.     store "This is a test of a TEST is a TTTT is a isIS  " to WRKSTR
  193. endif
  194. *<<<
  195. if &ISNULL
  196.    @ 22,05 say "Enter string operand       ->" GET WRKSTR
  197.    read
  198. endif 
  199.  
  200. *** end of TOOLINIT ***************************************
  201. *
  202. *
  203.  
  204. *
  205. *
  206. *********************************************** TOOLSLIB.CMD 
  207. *                          08.05.84
  208. *        dBASEII tools
  209. *        following the functions
  210. *        in K and R Software Tools and C Function library
  211. *  
  212. *  
  213. *
  214. ************************************************************ 
  215. *
  216. *** build a concatenated string
  217. *** store "store TRIM( WRKSTR) + NEWSTR" to STRCAT
  218. *
  219.  
  220. *** breakdown a string
  221. *** store "store $(WRKSTR,POS,POS1)" to GETSTRG
  222. *** store "store $(WRKSTR, 1,@(ISSPACE,WRKSTR) to PUTSTRING" to GETWORD
  223.  
  224. ***   check for other types of character
  225. ***   tab 
  226. store "chr(rank( &C )) = '09'" to ISTAB
  227.  
  228. ***   is an ASCII character
  229. store "chr(rank( &C )) < '128'" to ISASCII
  230.  
  231. ***   is a control character
  232. store "chr(rank( &C )) => '0' .and. chr(rank( &C )) => '32'" to ISCNTRL
  233.  
  234. ***   CP/M needs these
  235. ***   carriage return 
  236. store "chr(rank( &C )) = '13'" to ISCR
  237. ***   line feed
  238. store "chr(rank( &C )) = '10'" to ISLF
  239. ***   <RET> carriage return and line feed
  240. store "chr(rank( &C )) = '10' .and. chr(rank( &NEXTC )) => '13' .or. chr(rank( &C )) = '13' .and. chr(rank( &NEXTC )) => '10'" to ISRET
  241.  
  242. ***   text punctuation
  243. *     WARNING the following 2 functions are apt to upset some word processors!!
  244. *
  245. store "&C $ (,.?!'"();:`-) .or. store "chr(rank( &C )) => '40' .or. ;
  246. store "chr(rank( &C )) => '41'" to ISPUNCT
  247.  
  248. ***   all keyboard punctuation i.e. .not. alphanumeric or control (incl <RET>)
  249. store "&C = ISPUNCT .OR &C $ (@#$%^&*][_+=~|\}{/.<) to ISKYPNCT
  250.  
  251. ***   any printable character
  252. store "chr(rank( &C )) => '32' .or. chr(rank( &C )) < '128'" to ISPRINT
  253.  
  254. ***   an alphabetic character
  255. store "chr(rank( &C )) => '65' .and. chr(rank( &C )) <= '90' .or. chr(rank( &C )) => '97' chr(rank( &C )) =< '122'"       to ISALPHA
  256.  
  257. ***   isalphanumeric character
  258. store "ISALPHA .OR. ISDIGIT" to ISALPHNM
  259.  
  260. *
  261. **** end of STRFLIB.CMD ********************************
  262. *
  263. *
  264. *
  265. *\NP
  266. *
  267. *
  268. *******************************************************
  269. *********************************************** TOOLCASE.CMD
  270. *                          08.01.84
  271. *
  272. *      STRING FUNCTION LIBRARY CASE
  273. *      incorporating the Software Tools
  274. *
  275. *      NOTES ON USAGE
  276. *      ==============
  277. *      This file requires obtaining of the parameters 
  278. *      from a calling program
  279. *      it also requires that TOOLINIT be run to initialise memory
  280. *      Don't say    if WRKSTR = &ISNULL
  281. *      Just say     if &ISNULL
  282. *      Added Parens to empty, isupper, islower to avoid problem
  283. *      with statements like ".not. &ISNULL" which contains an .and.
  284. *      See Replace header for comments on trim and accept
  285. *
  286. *      Functions implemented are:
  287. *      LOWER   LTRIM   REPLACE 
  288. *      WORD      WRAP      CENTER
  289. *
  290. ********************************************************
  291. *
  292. *
  293. store "        " to FUNCTION
  294. *>>> Delete these later
  295. if FUNCTION = "WORD" .OR. FUNCTION = "WRAP" .OR. "JUSTIFY"
  296. store "XXXX is an EXTREMELY long string for testing the capacity of wrap;
  297. to perform its menial little but somewhat important task.  In short its ;
  298. a test!  Testing, testing?" to WRKSTR
  299. else
  300.     store "This is a test of a TEST TTTTT   isIS  " to WRKSTR
  301. endif
  302. *<<<
  303. if &ISNULL
  304.    @ 22,05 say "Enter string operand       ->" GET WRKSTR
  305.    read
  306. endif 
  307.  
  308. *** start of case 
  309.  
  310. do case
  311.     case FUNCTION="LOWER"
  312.  
  313. *\NP
  314. **********************************************    LOWER.CMD
  315. ***                          07.30.84
  316. ***      Convert string to lowercase
  317. *
  318. *********************************************************
  319. *
  320. *** start newstring
  321. *
  322. set talk ON
  323.  
  324.  
  325. &FIRSTC
  326. if &ISUPPER
  327.    store &TOLOWER to PUTSTRING
  328. ELSE
  329.    &PUTNWSTR
  330. endif
  331.  
  332.  
  333. *** convert each char until eos
  334.  
  335. &NEXTC
  336. do while .NOT. &EOS
  337.  
  338.    if &ISUPPER
  339.       stor PUTSTRING + &TOLOWER to PUTSTRING
  340.    else
  341.       &CHARCAT
  342.    endif
  343.  
  344.    &NEXTC
  345. enddo
  346.  
  347. return
  348.  
  349. *** end lower ******************************************
  350.  
  351.         case FUNCTION = "LTRIM"
  352. *\NP
  353. *********************************************** LTRIM.CMD
  354. ***                          07.30.84
  355. ***      LTRIM
  356. ***      strips leading blanks that may occur from 
  357. ***      conversion from numeric to string
  358. *
  359. ***********************************************************
  360. *
  361. *
  362. *** start at first char
  363. &FIRSTC
  364.  
  365. *** move past blank chars
  366. do while &ISSPACE
  367.     &NEXTC
  368. enddo
  369.  
  370. *** get rest of string
  371. store $( WRKSTR, POS) to PUTSTRING
  372. *
  373. *** end
  374.  
  375. NOTE POS with no LEN arg pointing to blank is like WRKSTR from POS
  376. NOTE to the EOS
  377.  
  378. *** end ltrim **************************************************
  379.  
  380.         case FUNCTION = "REPLACE"
  381.  
  382. stor WRKSTR to PUTSTRING
  383. *\NP
  384. *********************************************** REPLACE.CMD
  385. ***                          08.01.84
  386. ***      grep?
  387. ***      REPLACE search and replace patterns 
  388. ***      Uses 3 arguments
  389. ***      string, oldpattern, newpattern
  390. ***      stor trim( NEWPATTERN) would prohibit newpattern 
  391. ***      with a space!
  392. ***      note - use of Accept preferred which allows for a 
  393. ***      space at end of string
  394. ***      get would leave a 'tail' so a compare to a trimmed 
  395. ***      string would fail
  396. *
  397. *******************************************************************
  398. *
  399. *
  400.  
  401. *** make a copy of the string to work with
  402. &FIRSTC
  403. *** process string while oldpattern
  404. *** is still found inside newstring
  405. do while !( OLDPATTERN) $ !($( PUTSTRING, POS)) .AND. ;
  406.         .not. &EOS
  407. *** get the starting position of the old pattern
  408. stor @(!( OLDPATTERN), !($( PUTSTRING, POS))) + POS-1 TO POSITION
  409.  
  410. *** rebuild newstring without old pattern
  411. if POSITION = 1
  412.    stor NEWPATTERN + $( PUTSTRING, LEN( OLDPATTERN)) to PUTSTRING
  413. else
  414.    stor $( PUTSTRING,1, POSITION-1) + NEWPATTERN + $( PUTSTRING,POSITION + LEN(OLDPATTERN)) to PUTSTRING
  415. ? PUTSTRING
  416. endif
  417.  
  418. *** move cpointer past newpattern
  419. stor POSITION + LEN( NEWPATTERN) to POS
  420.  
  421. enddo
  422.  
  423. *** erase
  424.  
  425. rele OLDPATTERN, NEWPATTERN, POSITION
  426. *
  427. *** end replace *************************************************
  428.  
  429.         case FUNCTION ="WORD"
  430. *\NP
  431. *********************************************** WORD.CMD
  432. ***                          07.30.84
  433. ***      getword - extract the next word
  434. ***      See WORDWR for version with a wrapper "Testword"
  435. ***      Changed Empty to contain the parens else must use  
  436. ***      the syntax ".not. (&ISNULL)" to avoid problem with not/and/and
  437. ***      in the wrapper (does not apply with bare bones word 
  438. *
  439. *** word *******************************************************
  440. *
  441. *
  442. *** look for next non-blank char
  443. stor F to INWORD
  444. do while .not. INWORD .and. .not. &EOS
  445.  
  446.     if .not. &ISSPACE
  447.     * a char has been found so start newstring
  448.     stor T to INWORD
  449.     &PUTNWSTR
  450.     endif
  451.  
  452.     &NEXTC
  453. enddo
  454.  
  455. *** add the rest of the chars to newstring
  456. do while INWORD .and. .not. &EOS
  457.  
  458.     if .not. &ISSPACE
  459.     &CHARCAT
  460.     &NEXTC
  461.     Stor T to flag5
  462.     * stop when a blank is reached
  463.     else
  464.     stor F to INWORD
  465.     endif
  466.  
  467. enddo
  468.  
  469. rele inword
  470.  
  471. *** end word ************************************
  472. *
  473.  
  474.         case FUNCTION = "WRAP"
  475. *\NP
  476. ************************************************* WRAP.CMD
  477. ***                            07.30.84
  478. ***      WRAP a line 
  479. ***      word wrap function requires parameter (MAXLINE)
  480. ***      to be passed for length of line
  481. *
  482. ************************************************** 
  483. *
  484. *
  485. *** start a new print line
  486. ?
  487.  
  488.  
  489. *** set the printing position of character to start of line
  490. stor 0 to printed
  491.  
  492. *** process the string
  493. &FIRSTC
  494. do while .not. &EOS
  495.  
  496.     *  get the next word
  497.     DO WORD
  498.  
  499.     * if word won't fit start a new line
  500.     if LEN( PUTSTRING) + PRINTED > MAXLINE
  501.        ?
  502.        STORE 0 TO PRINTED
  503.     endif
  504.  
  505.     * print the word without <RET>
  506.     ?? PUTSTRING
  507.  
  508.     * increase the printing position of character
  509.     stor LEN( PUTSTRING) + PRINTED +1 to PRINTED
  510. enddo
  511.  
  512. rele PRINTED, PUTSTRING, MAXLINE
  513.  
  514. *** end wrap ***********************************
  515. *
  516.         case FUNCTION = "CENTER"
  517.  
  518. *\NP
  519. ************************************************ CENTER.CMD
  520. ***                           07.30.84
  521. *
  522. *
  523. ***      center a string
  524. *
  525. ***      requires parameter maxline to be passed
  526. *
  527. ************************************************
  528. *
  529. *
  530. store "                                            " TO BLNKS
  531.  
  532. *** trim off the leading spaces
  533. do LTRIM
  534.  
  535. *** calculate blanks before sting is printed
  536. stor ( MAXLINE - len(trim( PUTSTRING))) /2 TO LEFTFILL
  537.  
  538. if LEFTFILL >0
  539.     ? $( BLNKS, 1, LEFTFILL) + PUTSTRING
  540. else
  541.     ? PUTSTRING
  542. endif
  543.  
  544. rele maxline, leftfill, blanks
  545. *
  546. *** end center *********************************
  547. *
  548.         otherwise
  549. eras
  550. ?
  551. ?
  552. ?
  553. ACCE "&FUNCTION is not a valid function call on this system - try again  -> " to FUNCTION
  554.  
  555. endcase
  556.  
  557. return
  558. *
  559. *** end toolslib function lirary *******************
  560. *
  561.  
  562. ***  spare parts for functions
  563. *
  564. ***
  565. *** store "&C               "    to   
  566. *** store "&C               "    to   
  567. *
  568. *** store "chr(rank( &C )) => '65' .and. chr(rank( &C )) <= '90' .or. chr(rank( &C )) => '97' chr(rank( &C )) =< '122'"        to 
  569. *** store "chr(rank( &C )) => '65' .and. chr(rank( &C )) <= '90' .or. chr(rank( &C )) => '97' chr(rank( &C )) =< '122'"        to 
  570. *** 
  571. *** store "chr(rank( &C )) => 
  572. *** store "chr(rank( &C )) => 
  573. *** 
  574. ****************************************************** END
  575.  store "chr(rank( &C )) => 
  576. *** store "chr(rank( &C ))